home *** CD-ROM | disk | FTP | other *** search
/ Garbo / Garbo.cdr / mac / hypercrd / xcmd / dxcmds34.sit / Dartmouth XCMD's 3.4.3 / card_12558.txt < prev    next >
Text File  |  1990-04-17  |  11KB  |  353 lines
  1. -- card: 12558 from stack: in.3
  2. -- bmap block id: 0
  3. -- flags: 4000
  4. -- background id: 3241
  5. -- name: IsResource
  6. ----- HyperTalk script -----
  7. on Install
  8.   get ChooseTargetStack()
  9.   InstallResource XFCN,IsResource,it
  10. end Install
  11.  
  12.  
  13. -- part 1 (button)
  14. -- low flags: 00
  15. -- high flags: A003
  16. -- rect: left=66 top=300 right=322 bottom=209
  17. -- title width / last selected line: 0
  18. -- icon id / first selected line: 0 / 0
  19. -- text alignment: 1
  20. -- font id: 0
  21. -- text size: 12
  22. -- style flags: 0
  23. -- line height: 16
  24. -- part name: Check for an XCMD
  25. ----- HyperTalk script -----
  26. on mouseUp
  27.   global resInfo
  28.   put "XCMD" into resType
  29.   ask "Which" && resType && "do you want to check for?"
  30.   put it into resName
  31.   get IsResource(resType, resName)
  32.   if it is true then
  33.     answer item 1 of resInfo && item 3 of resInfo & "," && item 2 of resInfo & "," && item 4 of resInfo && "bytes." with "OK"
  34.   else answer resType && resName && "not found." with "OK"
  35. end mouseUp
  36.  
  37.  
  38.  
  39. -- part 2 (field)
  40. -- low flags: 81
  41. -- high flags: 2007
  42. -- rect: left=12 top=26 right=298 bottom=491
  43. -- title width / last selected line: 0
  44. -- icon id / first selected line: 0 / 0
  45. -- text alignment: 0
  46. -- font id: 22
  47. -- text size: 10
  48. -- style flags: 0
  49. -- line height: 13
  50. -- part name: Source
  51.  
  52.  
  53. -- part 3 (button)
  54. -- low flags: 00
  55. -- high flags: A003
  56. -- rect: left=299 top=300 right=322 bottom=438
  57. -- title width / last selected line: 0
  58. -- icon id / first selected line: 0 / 0
  59. -- text alignment: 1
  60. -- font id: 0
  61. -- text size: 12
  62. -- style flags: 0
  63. -- line height: 16
  64. -- part name: Show Pascal Source
  65. ----- HyperTalk script -----
  66. on mouseUp
  67.   set the visible of card field 1 to not the visible of card field 1
  68.   if the visible of card field 1 is true then
  69.     set the name of me to "Hide Pascal Source"
  70.   else set the name of me to "Show Pascal Source"
  71. end mouseUp
  72.  
  73.  
  74.  
  75. -- part contents for background part 16
  76. ----- text -----
  77. ISRESOURCE XFCN version 1.0.2
  78. Kevin Calhoun
  79.  
  80. IsResource checks for the availability of a resource by its resource type and name, by its resource type and ID, or by its resource type, name, and ID.  You can check for the presence of a resource in any currently open resource file or in just the most recently opened resource file.
  81.  
  82. If IsResource returns TRUE, additional information about the resource will be available in the global variable "resInfo."  (This requires HyperCard 1.2 or later.)  Item 1 of resInfo will be the resource type, item 2 the resource name, item 3 the resource ID, item 4 the size of the resource in bytes, and item 5 the name of the resource file in which the resource was found.
  83.  
  84. INVOKING ISRESOURCE
  85.  
  86. get IsResource("resType",<"resName">,<resID>,<mostRecentOnly>)
  87.  
  88. result:  true or false
  89.  
  90. If the fourth parameter, which is optional, is TRUE, IsResource checks only the most recently opened resource file.  Note that the most recently opened resource file is not necessarily that of the current stack (the current stack might not have a resource fork).  If you want to be certain that an existing resource is contained in a particular stack, use the following function:
  91.  
  92. function ResInStack resType,resName,resID,stackName
  93.   global resInfo
  94.   lock screen
  95.   push card
  96.   go to stack stackName
  97.   put the long name of this stack into stackPathname
  98.   delete word 1 of stackPathname
  99.   delete char 1 of stackPathname
  100.   delete last char of stackPathName
  101.   put IsResource(resType,resName,resID,TRUE) into resExists
  102.   pop card
  103.   unlock screen
  104.   if resExists is FALSE then return FALSE
  105.   else return (item 5 of resInfo is stackPathname)
  106. end ResInStack
  107.  
  108. EXAMPLES
  109.  
  110. IsResource("XCMD", "PrintField") would return true if an XCMD named PrintField were available in any one of the currently open resource files.  IsResource("XCMD", "PrintField", 9140) would return true if an XCMD named PrintField and numbered 9140 were available in any currently open resource file.  IsResource("XCMD",empty, 9140) would return true if any XCMD numbered 9140 were currently available.
  111.  
  112. REVISION HISTORY
  113. 15 March 1989  1.0
  114. 30 April 1989  1.0.1 --  Item 5 of global resInfo is now full pathname of file containing resource.  Also, IsResource no longer leaves an orphaned handle in heap.
  115. 11 June 1989 1.0.2 --  Fixed problem of not getting full pathname of system file when resource lives there.  Inside Macintosh lies.  Volume 1, page 116:  "When calling...HomeResFile..., be aware that for the system resource file the actual reference number is returned."  Not true.  Zero is returned.  Also, fixed problem of not returning the resource type correctly when a resource type of more than 4 characters is supplied.  (IsResource ignores the extra characters.) 
  116.  
  117. -- part contents for card part 2
  118. ----- text -----
  119. UNIT IsResourceUnit;
  120.  
  121. { IsResource XFCN ┬⌐ 1989 by the Trustees of Dartmouth College }
  122. { Written by Kevin Calhoun }
  123.  
  124. { This source compatible with MPW Pascal 3.0 }
  125.  
  126. (*
  127. Pascal IsResource.p
  128. Link -m ENTRYPOINT Γêé
  129.      -o "{boot}Hyper ╞Æ:HyperCard Stacks:Dartmouth XCMD's 3.1" Γêé
  130.      -rt XFCN=7508 Γêé
  131.      -sn Main=IsResource Γêé
  132.      IsResource.p.o Γêé
  133.     "{Libraries}"interface.o Γêé
  134.     "{PLibraries}"Paslib.o Γêé
  135.     "{Libraries}"HyperXLib.o
  136. *)
  137.  
  138. {$S IsResource }
  139. {$R-}
  140.  
  141. interface
  142.   USES
  143.     Types,
  144.     Memory,
  145.     Resources,
  146.     Files,
  147.     Errors,
  148.     ToolUtils,
  149.     OSUtils,
  150.     HyperXCmd;
  151.  
  152.   PROCEDURE EntryPoint (paramPtr : XCMDPtr);
  153.  
  154. IMPLEMENTATION
  155.  
  156. {-----------------------------------------------------------------}
  157.  
  158.   PROCEDURE IsResource (paramPtr: XCMDPtr); FORWARD;
  159.  
  160.   PROCEDURE EntryPoint (paramPtr : XCMDPtr);
  161.   BEGIN
  162.     IsResource(paramPtr);
  163.   END;
  164.   
  165.   FUNCTION SysRefNum: INTEGER;
  166.     CONST
  167.       SysMap=$A58; { reference number of sysResFile [word] I-114 }
  168.     TYPE
  169.       WordPtr = ^INTEGER;
  170.     VAR
  171.       w: WordPtr;
  172.   BEGIN
  173.     w := WordPtr(SysMap);
  174.     SysRefNum := w^;
  175.   END;
  176.  
  177.   PROCEDURE DirIDToPath(dirID: INTEGER; vRefNum: INTEGER; VAR path: Str255);
  178.     LABEL 99;
  179.     VAR
  180.       result: INTEGER;
  181.       str:  Str255;
  182.       pbHandle: Handle;
  183.       pb:   CInfoPBPtr;
  184.   BEGIN
  185.     path := '';
  186.     pbHandle := NewHandleClear(SIZEOF(CInfoPBRec));
  187.     IF MemError <> noErr THEN GOTO 99;
  188.     
  189.     HLock(pbHandle);
  190.     pb := CInfoPBPtr(pbHandle^);
  191.     pb^.ioDirID := dirID;
  192.     WHILE pb^.ioDirID <> 1 DO 
  193.       BEGIN
  194.       pb^.ioNamePtr := @str;
  195.       pb^.ioFDirIndex := -1;
  196.       pb^.ioVRefNum := vRefNum;
  197.       IF PBGetCatInfo(pb,FALSE) <> noErr THEN Exit(DirIDToPath);
  198.       path := Concat(str,':',path);
  199.       pb^.ioDirID := pb^.ioDrParID;
  200.       END;
  201.     99: IF pbHandle <> NIL THEN DisposHandle(pbHandle);
  202.   END;
  203.   
  204.   PROCEDURE FRefNumToPathname(fRefNum: INTEGER; VAR path: Str255);
  205.     LABEL 99;
  206.     VAR
  207.       err: OSErr;
  208.       myFCBPBHndl: Handle;
  209.       myFCBPBPtr: FCBPBPtr;
  210.       fName: Str255;
  211.       
  212.   BEGIN
  213.     err := noErr;
  214.     path := '';
  215.     myFCBPBHndl := NewHandleClear(SIZEOF(FCBPBRec));
  216.     IF MemError <> noErr THEN GOTO 99;
  217.     
  218.     HLock(myFCBPBHndl);
  219.     myFCBPBPtr := FCBPBPtr(myFCBPBHndl^);
  220.     WITH myFCBPBPtr^ DO
  221.       BEGIN
  222.       ioNamePtr := @fName;
  223.       ioRefNum := fRefNum;
  224.       END;
  225.     err := PBGetFCBInfo(myFCBPBPtr, FALSE);
  226.     IF err=noErr THEN
  227.       BEGIN
  228.       DirIDToPath(myFCBPBPtr^.ioFCBParID, myFCBPBPtr^.ioFCBVRefNum,path);
  229.       path := CONCAT(path,fName);
  230.       END;
  231.     
  232.     99: IF myFCBPBHndl <> NIL THEN DisposHandle(myFCBPBHndl);
  233.   END;
  234.   
  235.   FUNCTION MyGetResource(rType: ResType; id: INTEGER; oneFile: BOOLEAN): Handle;
  236.   BEGIN
  237.     IF oneFile THEN MyGetResource := Get1Resource(rType, id)
  238.     ELSE MyGetResource := GetResource(rType, id);
  239.   END;
  240.     
  241.   FUNCTION MyGetNamedResource(rType: ResType; name: Str255; oneFile: BOOLEAN): Handle;
  242.   BEGIN
  243.     IF oneFile THEN MyGetNamedResource := Get1NamedResource(rType, name)
  244.     ELSE MyGetNamedResource := GetNamedResource(rType, name);
  245.   END;
  246.     
  247.   PROCEDURE IsResource (paramPtr: XCMDPtr);
  248.     VAR
  249.       paramCount: INTEGER;
  250.       str,resName: Str255;
  251.       resourceType, resID, resSize: String[5];
  252.       theID, anID: INTEGER;
  253.       theType: ResType;
  254.       r1, r2, h: Handle;
  255.       size: LONGINT;
  256.       gotName, gotID, topMapOnly, present: BOOLEAN;
  257.       nullPos: INTEGER;
  258.       zero: String[1];
  259.       fileRefNum: INTEGER;
  260.       err: OSErr;
  261.  
  262.     PROCEDURE passReturnValue (errMsg : Str255); { set theResult }
  263.     BEGIN
  264.       paramPtr^.returnValue := PasToZero(paramPtr, errMsg);
  265.     END;
  266.  
  267.   BEGIN
  268.     paramCount := paramPtr^.paramCount;
  269.     r1 := NIL;
  270.     r2 := NIL;
  271.     err := resNotFound;
  272.     IF paramCount > 1 THEN
  273.       BEGIN
  274.       zero := ' ';
  275.       zero[1] := CHR(0);
  276.       ZeroToPas(paramPtr, paramPtr^.params[1]^,str);
  277.       BlockMove(POINTER(ORD4(@str)+1), @theType, 4);
  278.       ZeroToPas(paramPtr, paramPtr^.params[2]^, resName);
  279.       gotName := LENGTH(resName) > 0;
  280.       gotID := FALSE;
  281.       IF paramCount > 2 THEN
  282.         BEGIN
  283.         ZeroToPas(paramPtr, paramPtr^.params[3]^, str);
  284.         IF LENGTH(str) > 0 THEN
  285.           BEGIN
  286.           gotID := TRUE;
  287.           theID := LoWord(StrToNum(paramPtr, str));
  288.           END;
  289.         END;
  290.       topMapOnly := FALSE;
  291.       IF paramCount > 3 THEN
  292.         BEGIN
  293.         ZeroToPas(paramPtr,paramPtr^.params[4]^,str);
  294.         topMapOnly := StrToBool(paramPtr,str);
  295.         END;
  296.       SetResLoad(FALSE);
  297.       IF gotName THEN
  298.         BEGIN
  299.         r1 := MyGetNamedResource(theType, resName, topMapOnly);
  300.         GetResInfo(r1, anID, theType, resName);
  301.         err := ResError;
  302.         IF (err = noErr) AND gotID THEN
  303.           BEGIN
  304.           r2 := MyGetResource(theType, theID, topMapOnly);
  305.           GetResInfo(r2, theID, theType, str);
  306.           err := ResError;
  307.           if err = noErr then
  308.             if (anID <> theID) or NOT EqualString(resName,str,FALSE,TRUE) then
  309.               err := resNotFound;
  310.           END;
  311.         theID := anID;
  312.         END
  313.       ELSE IF gotID THEN
  314.         BEGIN
  315.         r1 := MyGetResource(theType, theID, topMapOnly);
  316.         GetResInfo(r1, theID, theType, resName);
  317.         err := ResError;
  318.         END;
  319.       SetResLoad(TRUE);
  320.       present := err = noErr;
  321.       BoolToStr(paramPtr, present, str);
  322.       PassReturnValue(str);
  323.       IF present THEN
  324.         BEGIN
  325.         resourceType[0] := CHR(4);
  326.         BlockMove(@theType,Ptr(ORD4(@resourceType)+1),4);
  327.         NumToStr(paramPtr, theID, str);
  328.         resID := str;
  329.         size := SizeResource(r1);
  330.         NumToStr(paramPtr, size, str);
  331.         resSize := str;
  332.         { remove nulls from resource name }
  333.         nullPos := POS(zero, resName);
  334.         WHILE nullPos > 0 DO
  335.           BEGIN
  336.           DELETE(resName, nullPos, 1);
  337.           nullPos := POS(zero, resName);
  338.           END;
  339.         fileRefNum := HomeResFile(r1);
  340.         IF fileRefNum = 0 THEN fileRefNum := SysRefNum;
  341.         FRefNumToPathname(fileRefNum,str);
  342.         str := CONCAT(resourceType,',',resName,',',resID, ',',resSize,',',str);
  343.         h := PasToZero(paramPtr, str);
  344.         SetGlobal(paramPtr, 'resInfo', h);
  345.         DisposHandle(h);
  346.         END;
  347.       END
  348.     ELSE
  349.       PassReturnValue('IsResource XFCN 1.0.2, 11 June 1989, ┬⌐1989 Dartmouth College');
  350.   END;
  351.   
  352. END.
  353.